home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src / ace / c / basfun.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-10-04  |  42.0 KB  |  1,755 lines
  1. /* << ACE >>
  2.    
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Intrinsic Functions **
  6.    ** Copyright (C) 1998 David Benn
  7.    ** 
  8.    ** This program is free software; you can redistribute it and/or
  9.    ** modify it under the terms of the GNU General Public License
  10.    ** as published by the Free Software Foundation; either version 2
  11.    ** of the License, or (at your option) any later version.
  12.    **
  13.    ** This program is distributed in the hope that it will be useful,
  14.    ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.    ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.    ** GNU General Public License for more details.
  17.    **
  18.    ** You should have received a copy of the GNU General Public License
  19.    ** along with this program; if not, write to the Free Software
  20.    ** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22.    Author: David J Benn
  23.      Date: 16th-30th November, 1st-12th December 1991,
  24.        27th January 1992, 
  25.            6th,11th,14th,17th,28th,29th February 1992,
  26.        23rd March 1992,
  27.        21st April 1992,
  28.        2nd,11th,15th May 1992,
  29.        8th,14th,28th June 1992,
  30.        2nd,5th,14th,15th,26th-28th July 1992,
  31.        2nd,9th August 1992,
  32.        6th,7th,8th,13th,29th December 1992,
  33.        5th January 1993,
  34.        14th,18th February 1993,
  35.        8th,10th March 1993,
  36.        25th,30th May 1993,
  37.        6th,13th,19th,30th June 1993,
  38.        1st,3rd,4th July 1993,
  39.        5th,25th September 1993,
  40.        10th,11th October 1993,
  41.        2nd,9th November 1993,
  42.        24th,28th December 1993,
  43.        6th January 1994,
  44.        7th,26th,27th February 1994,
  45.        4th April 1994,
  46.        28th August 1994,
  47.        3rd,4th September 1994,
  48.        5th,11th March 1995,
  49.        10th March 1996
  50. */
  51.  
  52. #include "acedef.h"
  53.  
  54. /* locals */
  55. static    char    *addreg[] = { "a4","a5" };
  56.  
  57. /* externals */   
  58. extern    int     sym;
  59. extern    int     lev;
  60. extern    int    struct_member_type;
  61. extern    char     id[MAXIDSIZE];   
  62. extern    char     ut_id[MAXIDSIZE];
  63. extern    SYM    *curr_item;
  64. extern    char     tempstrname[80];
  65. extern    char    strstorename[80];
  66. extern    char    strstorelabel[80];
  67. extern    BOOL     cli_args;
  68. extern    BOOL     break_opt;
  69. extern    BOOL    have_lparen;
  70.  
  71. /* string functions */
  72. BOOL strfunc()
  73. {
  74.  switch(sym)
  75.  {
  76.   case argstrsym    : return(TRUE);
  77.   case ascsym           : return(TRUE);
  78.   case binstrsym    : return(TRUE);
  79.   case chrstrsym       : return(TRUE);
  80.   case cstrsym        : return(TRUE);
  81.   case fileboxstrsym    : return(TRUE);
  82.   case hexsym           : return(TRUE); 
  83.   case inputboxsym    : return(TRUE);    /* this is here for convienience */
  84.   case inputboxstrsym    : return(TRUE);
  85.   case inputstrsym     : return(TRUE);
  86.   case instrsym        : return(TRUE);
  87.   case leftstrsym      : return(TRUE);
  88.   case lensym           : return(TRUE);
  89.   case midstrsym       : return(TRUE);
  90.   case octstrsym       : return(TRUE);
  91.   case ptabsym        : return(TRUE);
  92.   case rightstrsym     : return(TRUE);
  93.   case saddsym        : return(TRUE);
  94.   case spacestrsym    : return(TRUE);
  95.   case spcsym        : return(TRUE);
  96.   case strstrsym       : return(TRUE);
  97.   case stringstrsym    : return(TRUE);
  98.   case tabsym         : return(TRUE);
  99.   case translatestrsym     : return(TRUE);
  100.   case ucasestrsym     : return(TRUE);
  101.   case valsym          : return(TRUE);
  102.  }
  103.  return(FALSE);
  104. }
  105.  
  106. int stringfunction()
  107. {
  108. int  func;
  109. int  sftype=undefined;
  110. int  ntype=undefined;
  111. char buf[80],srcbuf[80];
  112. BOOL commaset=FALSE;
  113. BOOL offset_on_stack;
  114.  
  115.  if (strfunc()) 
  116.  {
  117.   func=sym;
  118.   insymbol();
  119.   if (sym != lparen) _error(14);
  120.   else
  121.   {
  122.    insymbol();
  123.    sftype=expr();
  124.     
  125.    switch(func)
  126.       {
  127.         /* CHR$ */
  128.         case chrstrsym : sftype=make_integer(sftype);
  129.                  if (sftype == longtype) 
  130.                  {
  131.                    make_short();
  132.                    sftype=shorttype;
  133.                  }
  134.  
  135.                    if (sftype != notype)
  136.                    {
  137.                     /* Ascii value to copy to string */
  138.                   gen("move.w","(sp)+","d0");
  139.                     /* create a string to copy value to */
  140.                     make_string_store();
  141.                     strcpy(buf,strstorename);
  142.                     gen("lea",buf,"a0");
  143.                     gen("jsr","_chrstring","  ");
  144.                     gen("pea",strstorename,"  ");
  145.                     enter_XREF("_chrstring");
  146.                     enter_BSS(strstorelabel,"ds.b 2");
  147.                     sftype=stringtype;
  148.                    }
  149.                   else { _error(4); sftype=undefined; }
  150.                 break;
  151.  
  152.     /* ARG$ */
  153.     case argstrsym  :    if (sftype != stringtype)
  154.             {
  155.              /* argument number */
  156.              if (make_integer(sftype)==shorttype) make_long();    
  157.              /* destination buffer */
  158.              make_temp_string();      
  159.              gen("pea",tempstrname,"  ");
  160.              gen("jsr","_arg","  ");
  161.              gen("addq","#8","sp");
  162.              gen("move.l","d0","-(sp)");
  163.              enter_XREF("_arg");
  164.              cli_args=TRUE;
  165.              sftype=stringtype;
  166.             }
  167.             else { _error(4); sftype=undefined; }
  168.             break;
  169.  
  170.     /* ASC */
  171.     case ascsym  :    if (sftype == stringtype) 
  172.             {
  173.              gen("move.l","(sp)+","a2");
  174.              gen("jsr","_asc","  ");
  175.              gen("move.w","d0","-(sp)");
  176.              enter_XREF("_asc");    
  177.              sftype=shorttype;
  178.             }
  179.             else { _error(4); sftype=undefined; }     
  180.                break;
  181.  
  182.     /* BIN$ */
  183.     case binstrsym  :    if (sftype != stringtype)
  184.             {
  185.              if (make_integer(sftype) == shorttype)
  186.                  make_long(); /* only handle long val */
  187.              make_temp_string();
  188.              gen("lea",tempstrname,"a0");
  189.              gen("move.l","(sp)+","d0"); /* long argument */
  190.              gen("jsr","_binstr","  ");
  191.              enter_XREF("_binstr");
  192.                  gen("move.l","a0","-(sp)"); /* push string result */
  193.              sftype=stringtype;
  194.              }
  195.              else { _error(4); sftype=undefined; }
  196.              break;
  197.  
  198.     /* CSTR */
  199.     case cstrsym : if ((sftype == stringtype) || (sftype == longtype))
  200.               sftype=stringtype;
  201.                  else
  202.               { _error(4); sftype=undefined; }
  203.            break;
  204.  
  205.     /* FILEBOX$ */
  206.     case fileboxstrsym : if (sftype == stringtype)  /* title */
  207.              {
  208.                 /* default directory? */
  209.                 if (sym == comma)
  210.                 {
  211.                     insymbol();
  212.                     if (expr() != stringtype) _error(4);
  213.                 }
  214.                 else
  215.                     gen("move.l","#0","-(sp)");
  216.     
  217.                 gen("jsr","_filerequest","  ");
  218.                 gen("addq","#8","sp");
  219.                 gen("move.l","d0","-(sp)");
  220.                 enter_XREF("_filerequest");
  221.                 enter_XREF("_GfxBase");
  222.                 sftype=stringtype;
  223.              }
  224.              else 
  225.                  { _error(4); sftype=undefined; }
  226.              break;
  227.  
  228.     /* HEX$ */
  229.     case hexsym  :    if (sftype != stringtype)
  230.             {
  231.              sftype = make_integer(sftype);
  232.              make_temp_string();
  233.              gen("lea",tempstrname,"a0");
  234.              if (sftype == longtype)
  235.              {
  236.               gen("move.l","(sp)+","d0");
  237.               gen("jsr","_hexstrlong","  ");
  238.               enter_XREF("_hexstrlong");
  239.              }
  240.              else
  241.               /* shorttype */
  242.               {
  243.                gen("move.w","(sp)+","d0");
  244.                gen("jsr","_hexstrshort","  ");
  245.                enter_XREF("_hexstrshort");
  246.               }
  247.               gen("move.l","a0","-(sp)");  /* push string result */
  248.               sftype=stringtype;
  249.              }
  250.              else { _error(4); sftype=undefined; }
  251.              break;
  252.               
  253.     /* INPUTBOX and INPUTBOX$ */
  254.     case inputboxsym :
  255.     case inputboxstrsym : if (sftype == stringtype)     /* prompt */     
  256.               {                
  257.                /* all other parameters are optional */
  258.  
  259.                if (sym == comma)         /* title */
  260.                {
  261.                 insymbol();
  262.                 if (sym != comma)
  263.                 {
  264.                     if (expr() != stringtype) _error(4);
  265.                 }
  266.                 else
  267.                     gen("move.l","#0","-(sp)");
  268.                }
  269.                else 
  270.                 gen("move.l","#0","-(sp)"); 
  271.  
  272.                if (sym == comma)        /* default value */
  273.                {
  274.                 insymbol();
  275.                 if (sym != comma)
  276.                 {
  277.                     if (expr() != stringtype) _error(4);
  278.                 }
  279.                 else
  280.                     gen("move.l","#0","-(sp)");
  281.                }
  282.                else 
  283.                 gen("move.l","#0","-(sp)");
  284.  
  285.                if (sym == comma)        /* xpos */
  286.                {
  287.                 insymbol();
  288.                 if (sym != comma)
  289.                 {
  290.                        if (make_integer(expr()) == shorttype)
  291.                         make_long();
  292.                 }
  293.                 else
  294.                     gen("move.l","#0","-(sp)");
  295.                }
  296.                else 
  297.                 gen("move.l","#0","-(sp)");
  298.  
  299.                if (sym == comma)        /* ypos */
  300.                {
  301.                 insymbol();
  302.                 if (sym != comma)
  303.                 {
  304.                        if (make_integer(expr()) == shorttype)
  305.                         make_long();
  306.                 }
  307.                 else
  308.                     gen("move.l","#0","-(sp)");
  309.                }
  310.                else 
  311.                 gen("move.l","#0","-(sp)");
  312.  
  313.                /* which function? */
  314.                if (func == inputboxsym)
  315.                {
  316.                 /* INPUTBOX */
  317.                 gen("jsr","_longint_input_box","  ");
  318.                 gen("add.l","#20","sp");
  319.                 gen("move.l","d0","-(sp)");
  320.                 enter_XREF("_longint_input_box");
  321.                 sftype = longtype;
  322.                }
  323.                else
  324.                {
  325.                 /* INPUTBOX$ */
  326.                 gen("jsr","_string_input_box","  ");
  327.                 gen("add.l","#20","sp");
  328.                 gen("move.l","d0","-(sp)");
  329.                 enter_XREF("_string_input_box");
  330.                 sftype = stringtype;
  331.                }
  332.  
  333.                /* both functions need graphics and intuition libraries! */
  334.                enter_XREF("_GfxBase");    
  335.               }
  336.               else { _error(4); sftype=undefined; }
  337.               break;
  338.              
  339.     /* INPUT$(X,[#]filenumber) */
  340.     case inputstrsym : if (sftype != stringtype)
  341.                { 
  342.             check_for_event();
  343.  
  344.             if (make_integer(sftype) == shorttype)
  345.                make_long();     /* no. of characters */
  346.  
  347.             if (sym == comma)
  348.             {
  349.              insymbol();
  350.              if (sym == hash) insymbol();
  351.              if (make_integer(expr()) == shorttype)
  352.                 make_long();      /* filenumber */
  353.             }
  354.             else { _error(16); sftype=undefined; }
  355.  
  356.                    gen("move.l","(sp)+","d0");  /* pop filenumber */
  357.                 gen("move.l","(sp)+","d1");  /* pop no. of characters */
  358.                    gen("jsr","_inputstrfromfile","  ");
  359.                    gen("move.l","d0","-(sp)");  /* push string result */
  360.  
  361.                    enter_XREF("_inputstrfromfile");
  362.                    enter_XREF("_DOSBase");
  363.                    sftype=stringtype;
  364.                }
  365.                else { _error(4); sftype=undefined; }
  366.                break;     
  367.         
  368.     /* INSTR$([I,]X$,Y$) */
  369.     case instrsym  :    if (sftype != stringtype)
  370.             {
  371.              if (make_integer(sftype) == shorttype) make_long();
  372.  
  373.              if (sym == comma) 
  374.              { 
  375.               offset_on_stack=TRUE;        /* optional offset I */
  376.               insymbol(); sftype=expr(); 
  377.              }
  378.              else
  379.                  { _error(16); sftype=undefined; }       
  380.             }    
  381.                 else 
  382.                 offset_on_stack=FALSE;
  383.  
  384.             /* get X$ and Y$ */
  385.                  if (sftype == stringtype)
  386.             {
  387.              if (sym == comma) 
  388.              {
  389.               insymbol();             
  390.               if (expr() == stringtype)
  391.               {
  392.                gen("movea.l","(sp)+","a1");        /* Y$ */
  393.                gen("movea.l","(sp)+","a0");        /* X$ */
  394.                if (offset_on_stack) 
  395.                   gen("move.l","(sp)+","d0");    /* I */
  396.                else
  397.                   gen("moveq","#1","d0");        /* I=1 */
  398.                
  399.                /* call INSTR */
  400.                gen("jsr","_instr","  ");
  401.                gen("move.l","d0","-(sp)");    /* posn of Y$ in X$ */
  402.                enter_XREF("_instr");
  403.                sftype=longtype;
  404.               }
  405.               else { _error(4); sftype=undefined; }
  406.              }
  407.              else { _error(16); sftype=undefined; }
  408.             }
  409.             else { _error(4); sftype=undefined; }
  410.             break;
  411.             
  412.     /* LEFT$ */
  413.     case leftstrsym :    if (sftype == stringtype)
  414.             {
  415.              if (sym == comma)
  416.              {
  417.               insymbol();
  418.               make_sure_short(expr());
  419.               gen("move.w","(sp)+","d0");  /* index */
  420.               gen("move.l","(sp)+","a0");  /* string */
  421.               make_temp_string();
  422.               gen("lea",tempstrname,"a1");
  423.               gen("jsr","_leftstr","  ");
  424.               gen("move.l","a0","-(sp)");  /* addr of left$ */
  425.               enter_XREF("_leftstr");
  426.               sftype=stringtype;
  427.              }
  428.              else { _error(16); sftype=undefined; }
  429.             }
  430.             else { _error(4); sftype=undefined; }
  431.             break;
  432.  
  433.     /* LEN */
  434.     case lensym  :    if (sftype == stringtype) 
  435.             {
  436.              gen("move.l","(sp)+","a2");
  437.              gen("jsr","_strlen","  ");
  438.              gen("move.l","d0","-(sp)");
  439.              enter_XREF("_strlen");    
  440.              sftype=longtype;
  441.             }
  442.             else { _error(4); sftype=undefined; }     
  443.                break;
  444.  
  445.     /* OCT$ */
  446.     case octstrsym  :    if (sftype != stringtype)
  447.             {
  448.              if (make_integer(sftype) == shorttype)
  449.                  make_long(); /* only handle long val */
  450.              make_temp_string();
  451.              gen("lea",tempstrname,"a0");
  452.              gen("move.l","(sp)+","d0"); /* long argument */
  453.              gen("jsr","_octstr","  ");
  454.              enter_XREF("_octstr");
  455.                  gen("move.l","a0","-(sp)"); /* push string result */
  456.              sftype=stringtype;
  457.              }
  458.              else { _error(4); sftype=undefined; }
  459.              break;
  460.  
  461.     /* RIGHT$ */
  462.     case rightstrsym :    if (sftype == stringtype)
  463.             {
  464.              if (sym == comma)
  465.              {
  466.               insymbol();
  467.               make_sure_short(expr());
  468.               gen("move.w","(sp)+","d0");  /* index */
  469.               gen("move.l","(sp)+","a0");  /* string */
  470.               make_temp_string();
  471.               gen("lea",tempstrname,"a1");
  472.                  gen("jsr","_rightstr","  ");
  473.               gen("move.l","a0","-(sp)");  /* addr of right$ */
  474.               enter_XREF("_rightstr");
  475.               sftype=stringtype;
  476.              }
  477.              else { _error(16); sftype=undefined; }
  478.             }
  479.             else { _error(4); sftype=undefined; }
  480.             break;
  481.  
  482.     /* SADD */
  483.     case saddsym :     if (sftype == stringtype)
  484.                      sftype=longtype; /* address is on stack */
  485.                else { _error(4); sftype=undefined; }
  486.                break;
  487.  
  488.     /* SPC, SPACE$ */
  489.     case spcsym:
  490.     case spacestrsym :  if (sftype != stringtype)
  491.             {
  492.              make_sure_short(sftype);
  493.              gen("move.w","(sp)+","d0");
  494.              make_temp_string();
  495.              gen("lea",tempstrname,"a0");
  496.              if (func == spacestrsym)
  497.                    gen("jsr","_spacestring","  ");
  498.              else
  499.                 gen("jsr","_spc","  ");
  500.              gen("move.l","d0","-(sp)");
  501.              if (func == spacestrsym)
  502.                 enter_XREF("_spacestring");
  503.              else
  504.                 enter_XREF("_spc");
  505.              sftype=stringtype;
  506.             }
  507.             else { _error(4); sftype=undefined; }
  508.             break;
  509.  
  510.     /* STR$ */
  511.     case strstrsym :    if (sftype != stringtype)
  512.             {
  513.              make_temp_string();
  514.              gen("lea",tempstrname,"a0");
  515.              if (sftype == longtype)
  516.              {
  517.               gen("move.l","(sp)+","d0");
  518.               gen("jsr","_strlong","  ");
  519.               enter_XREF("_strlong");
  520.               gen("move.l","a0","-(sp)");  /* push string result */
  521.              }
  522.              else
  523.               if (sftype == shorttype)
  524.               {
  525.                gen("move.w","(sp)+","d0");
  526.                gen("jsr","_strshort","  ");
  527.                enter_XREF("_strshort");
  528.                 gen("move.l","a0","-(sp)");  /* push string result */
  529.               }
  530.               else
  531.                if (sftype == singletype)
  532.                {
  533.                 gen("jsr","_strsingle","  ");
  534.                 gen("addq","#4","sp");
  535.                 gen("move.l","d0","-(sp)"); /* push string result */
  536.                 enter_XREF("_strsingle");
  537.                 enter_XREF("_MathBase");
  538.                }
  539.               sftype=stringtype;
  540.              }
  541.              else { _error(4); sftype=undefined; }
  542.              break;
  543.  
  544.     /*   STRING$(I,J) 
  545.       or STRING$(I,X$) */
  546.     case stringstrsym : if (sftype != stringtype)
  547.             {
  548.              make_sure_short(sftype);
  549.  
  550.              if (sym == comma)
  551.              {        
  552.               insymbol();
  553.               ntype=expr();
  554.  
  555.               if (ntype == stringtype)
  556.               {
  557.                gen("move.l","(sp)+","a0");
  558.                gen("move.b","(a0)","d1");
  559.                gen("ext.w","d1","  ");
  560.                gen("ext.l","d1","  ");    /* MID$(X$,1,1) */
  561.               }
  562.               else
  563.               {
  564.                if (make_integer(ntype) == shorttype) 
  565.                   make_long();
  566.                gen("move.l","(sp)+","d1");    /* J */            
  567.               }
  568.  
  569.               gen("move.w","(sp)+","d0");  /* I */
  570.  
  571.               /* call STRING$ */
  572.               make_temp_string();
  573.               gen("lea",tempstrname,"a0");
  574.               gen("jsr","_stringstr","  ");
  575.               gen("move.l","d0","-(sp)");    /* push string result */
  576.               enter_XREF("_stringstr");
  577.               sftype=stringtype;
  578.              }
  579.              else { _error(16); sftype=undefined; }
  580.                 }
  581.             else { _error(4); sftype=undefined; }    
  582.             break;    
  583.  
  584.     /* MID$ -> MID$(X$,n[,m]) */
  585.     case midstrsym :    if (sftype == stringtype)
  586.             {
  587.              if (sym == comma)
  588.              {
  589.               insymbol();           /* start position */
  590.               make_sure_short(expr());
  591.  
  592.                if (sym == comma)
  593.                {
  594.                 insymbol();        /* character count */
  595.                 make_sure_short(expr());
  596.                 commaset=TRUE;
  597.                }
  598.  
  599.                    if (commaset) 
  600.                   gen("move.w","(sp)+","d1");  /* char count */
  601.                  else
  602.                /* take the full length of the string */
  603.                gen("move.w","#-1","d1");  
  604.            
  605.                gen("move.w","(sp)+","d0");  /* start posn */
  606.                gen("move.l","(sp)+","a0");  /* string */
  607.                make_temp_string();
  608.                gen("lea",tempstrname,"a1");
  609.                    gen("jsr","_midstr","  ");
  610.                gen("move.l","a0","-(sp)");  /* addr of mid$ */
  611.                enter_XREF("_midstr");
  612.                sftype=stringtype;
  613.              }
  614.              else { _error(16); sftype=undefined; }
  615.             }
  616.             else { _error(4); sftype=undefined; }
  617.             break;
  618.  
  619.     /* PTAB */
  620.     case ptabsym :    if (sftype != stringtype)
  621.             {
  622.              make_sure_short(sftype);
  623.              gen("move.w","(sp)+","d0");  /* x coordinate */
  624.              gen("jsr","_ptab","  ");
  625.              gen("move.l","a0","-(sp)");  /* NULL ptab string */
  626.              enter_XREF("_ptab");
  627.              enter_XREF("_GfxBase");
  628.              sftype=stringtype;
  629.             }
  630.             else sftype=undefined; 
  631.             break;
  632.     
  633.     /* TAB */
  634.     case tabsym :    if (sftype != stringtype)
  635.             {
  636.              make_sure_short(sftype);
  637.              gen("move.w","(sp)+","d0");  /* # of columns */
  638.              gen("jsr","_horiz_tab","  ");
  639.              gen("move.l","a0","-(sp)");  /* addr of tab string */
  640.              enter_XREF("_horiz_tab");
  641.              enter_XREF("_DOSBase");
  642.              enter_XREF("_GfxBase");
  643.              sftype=stringtype;
  644.             }
  645.             else sftype=undefined; 
  646.             break;
  647.     
  648.     /* TRANSLATE$ */
  649.     case translatestrsym :if (sftype == stringtype)
  650.               {
  651.                gen("movea.l","(sp)+","a0"); /* instr */
  652.                make_temp_string();
  653.                gen("lea",tempstrname,"a1"); /* outstr */
  654.                gen("movea.l","a0","a2");
  655.                gen("jsr","_strlen","  "); /* inlen in d0 */
  656.                sprintf(srcbuf,"#%ld",MAXSTRLEN); /* #MAXSTRLEN */
  657.                gen("move.l",srcbuf,"d1"); /* outlen = MAXSTRLEN */
  658.                gen("movea.l","_TransBase","a6");
  659.                gen("jsr","_LVOTranslate(a6)","  ");
  660.                gen("pea",tempstrname,"  "); /* outstr on stack */
  661.                enter_XREF("_TransBase");
  662.                enter_XREF("_LVOTranslate");
  663.                enter_XREF("_strlen");
  664.                sftype=stringtype;
  665.               }
  666.               else { _error(4); sftype=undefined; }
  667.               break;
  668.     
  669.     /* UCASE$ */
  670.     case ucasestrsym  :    if (sftype == stringtype) 
  671.             {
  672.              gen("move.l","(sp)+","a1");
  673.                 make_temp_string();
  674.              gen("lea",tempstrname,"a0"); /* result buffer */
  675.              gen("jsr","_ucase","  ");
  676.              gen("move.l","a0","-(sp)");
  677.              enter_XREF("_ucase");    
  678.              sftype=stringtype;
  679.             }
  680.             else { _error(4); sftype=undefined; }     
  681.                break;
  682.  
  683.     /* VAL */
  684.     case valsym :    if (sftype == stringtype)
  685.             {
  686.              gen("jsr","_val","  "); /* string is on the stack */
  687.              gen("addq","#4","sp");
  688.              gen("move.l","d0","-(sp)");
  689.              enter_XREF("_val");
  690.              enter_XREF("_MathBase");  /* _val needs math libs */
  691.              enter_XREF("_MathTransBase");
  692.              sftype=singletype;
  693.             }
  694.             else { _error(4); sftype=undefined; } 
  695.             break;
  696.    }
  697.  
  698.    if (sym != rparen) { _error(9); sftype=undefined; }
  699.   }  
  700.   insymbol();
  701.  }
  702.  return(sftype);
  703. }
  704.  
  705. /* numeric functions */
  706. int gen_single_func(funcname,nftype)
  707. char *funcname;
  708. int  nftype;
  709. {
  710. char func[80];
  711.  
  712.   if (nftype != stringtype)
  713.   {
  714.    if (nftype != singletype) gen_Flt(nftype);  
  715.    gen("move.l","(sp)+","d0");
  716.    gen("movea.l","_MathTransBase","a6");
  717.    strcpy(func,funcname);
  718.    strcat(func,"(a6)");
  719.    gen("jsr",func,"  ");
  720.    gen("move.l","d0","-(sp)");
  721.    enter_XREF(funcname);
  722.    enter_XREF("_MathTransBase");
  723.    enter_XREF("_MathBase");
  724.    nftype=singletype;
  725.   }
  726.   else { _error(4); nftype=undefined; }
  727.  return(nftype);
  728. }
  729.  
  730. BOOL numfunc()
  731. {
  732.  switch(sym)
  733.  {
  734.   case abssym        : return(TRUE);
  735.   case allocsym         : return(TRUE);
  736.   case atnsym        : return(TRUE);
  737.   case cintsym       : return(TRUE);
  738.   case clngsym       : return(TRUE);
  739.   case cossym        : return(TRUE);
  740.   case csngsym       : return(TRUE);
  741.   case eofsym         : return(TRUE);
  742.   case expsym        : return(TRUE); 
  743.   case fixsym        : return(TRUE);
  744.   case fresym         : return(TRUE);
  745.   case gadgetsym     : return(TRUE);
  746.   case handlesym     : return(TRUE);
  747.   case iffsym        : return(TRUE);
  748.   case intsym        : return(TRUE);
  749.   case locsym         : return(TRUE);
  750.   case lofsym         : return(TRUE);
  751.   case logsym        : return(TRUE);
  752.   case longintsym        : return(TRUE);
  753.   case menusym         : return(TRUE);
  754.   case mousesym      : return(TRUE);
  755.   case msgboxsym     : return(TRUE);
  756.   case peeksym       : return(TRUE);
  757.   case peekwsym     : return(TRUE);
  758.   case peeklsym      : return(TRUE);
  759.   case pointsym      : return(TRUE);
  760.   case potxsym         : return(TRUE);
  761.   case potysym         : return(TRUE);
  762.   case saysym         : return(TRUE);
  763.   case screensym     : return(TRUE);
  764.   case serialsym     : return(TRUE);
  765.   case sgnsym        : return(TRUE);
  766.   case shlsym         : return(TRUE);
  767.   case shrsym         : return(TRUE);
  768.   case sinsym        : return(TRUE);
  769.   case sizeofsym     : return(TRUE);
  770.   case sqrsym        : return(TRUE);
  771.   case sticksym      : return(TRUE);
  772.   case strigsym      : return(TRUE);
  773.   case tansym        : return(TRUE);
  774.   case varptrsym     : return(TRUE);
  775.   case windowsym     : return(TRUE);
  776.  }
  777.  return(FALSE);
  778. }
  779.  
  780. int numericfunction()
  781. {
  782. int  func;
  783. int  nftype=undefined;
  784. int  targettype;
  785. char labname[80],lablabel[80];
  786. char buf[40],numbuf[40];
  787. char varptr_obj_name[MAXIDSIZE];
  788.  
  789.  if (numfunc()) 
  790.  {
  791.   func=sym;
  792.   insymbol();
  793.   if (sym != lparen) _error(14);
  794.   else
  795.   {
  796.    insymbol();
  797.    if ((func != varptrsym) && (func != sizeofsym)) nftype=expr();
  798.     
  799.    switch(func)
  800.       {
  801.        /* ABS */
  802.        case abssym : if (nftype == shorttype)
  803.                     {
  804.                    gen("move.w","(sp)+","d0");
  805.                   gen("jsr","_absw","  ");
  806.                   gen("move.w","d0","-(sp)");
  807.                   enter_XREF("_absw");
  808.                   }
  809.                   else
  810.                   if (nftype == longtype)
  811.                   {
  812.                    gen("move.l","(sp)+","d0");
  813.                   gen("jsr","_absl","  ");
  814.                   gen("move.l","d0","-(sp)");
  815.                   enter_XREF("_absl");
  816.                   }
  817.                   else
  818.                   if (nftype == singletype)
  819.                   {
  820.                    gen("move.l","(sp)+","d0");
  821.                   gen("jsr","_absf","  ");
  822.                   gen("move.l","d0","-(sp)");
  823.                   enter_XREF("_absf");
  824.             enter_XREF("_MathBase");
  825.                   }
  826.                   else { _error(4); nftype=undefined; }
  827.                   break;
  828.  
  829.      /* ALLOC */ 
  830.      case allocsym :if (nftype != stringtype)
  831.             {
  832.              /* minimum number of bytes to reserve */
  833.              if (make_integer(nftype) == shorttype) make_long();
  834.         
  835.              if (sym != comma)
  836.              {
  837.                 gen("move.l","#9","-(sp)");    /* 9 = default type */
  838.                 nftype=longtype;
  839.              }
  840.              else 
  841.              {
  842.               /* memory type specification */
  843.               insymbol();
  844.               nftype=expr();
  845.               if (nftype != stringtype)
  846.               {
  847.                     if (make_integer(nftype) == shorttype) 
  848.                           make_long(); 
  849.                     nftype=longtype;
  850.               }
  851.               else { _error(4); nftype=undefined; }
  852.              }
  853.  
  854.              /* call ACEalloc() function */
  855.              gen("jsr","_ACEalloc","  ");
  856.              gen("addq","#8","sp");
  857.              gen("move.l","d0","-(sp)");  /* push result */
  858.              enter_XREF("_ACEalloc"); 
  859.              enter_XREF("_IntuitionBase");
  860.             }
  861.             else { _error(4); nftype=undefined; }
  862.             break;
  863.        
  864.      /* ATN */
  865.          case atnsym  : nftype = gen_single_func("_LVOSPAtan",nftype);
  866.                 break;
  867.  
  868.      /* CINT */
  869.      case cintsym : nftype = make_integer(nftype);
  870.             if (nftype == longtype)
  871.                         { 
  872.                            make_short();
  873.                nftype=shorttype;
  874.              }
  875.             if (nftype == notype) 
  876.                { _error(4); nftype=undefined; }
  877.             break;
  878.  
  879.      /* CLNG */
  880.      case clngsym : if (nftype == singletype)
  881.             {
  882.              gen_round(nftype);
  883.              nftype=longtype;
  884.             }
  885.             else
  886.               if (nftype == shorttype)
  887.               {
  888.                 gen("move.w","(sp)+","d0");
  889.                gen("ext.l","d0","  ");
  890.                gen("move.l","d0","-(sp)");
  891.                nftype=longtype;
  892.               }
  893.               else
  894.                   if (nftype == stringtype)
  895.                   { _error(4); nftype=undefined; }
  896.             break;
  897.  
  898.      /* COS */
  899.          case cossym  : nftype = gen_single_func("_LVOSPCos",nftype);
  900.                 break;
  901.  
  902.      /* CSNG */
  903.      case csngsym : if ((nftype == shorttype) || (nftype == longtype))
  904.             {
  905.                gen_Flt(nftype);
  906.                nftype=singletype;
  907.             }
  908.              else 
  909.                 if (nftype == stringtype) 
  910.                    { _error(4); nftype=undefined; }
  911.             break; 
  912.                 
  913.         /* EOF */
  914.         case eofsym   : if (nftype != stringtype)
  915.               { 
  916.              check_for_event();
  917.  
  918.                 if (make_integer(nftype) == shorttype)
  919.                       make_long();    
  920.                 gen("move.l","(sp)+","d0"); /* pop filenumber */
  921.                 gen("jsr","_eoftest","  ");
  922.                 gen("move.l","d0","-(sp)");
  923.                 enter_XREF("_eoftest");
  924.                 enter_XREF("_DOSBase");
  925.                   nftype=longtype;
  926.               }
  927.               else { _error(4); nftype=undefined; }
  928.               break;
  929.  
  930.      /* EXP */
  931.          case expsym  : nftype = gen_single_func("_LVOSPExp",nftype);
  932.                 break;
  933.  
  934.      /* FIX */
  935.      case fixsym  : if (nftype == singletype)
  936.             {
  937.              gen("move.l","(sp)+","d0");
  938.              gen("movea.l","_MathBase","a6");
  939.              gen("jsr","_LVOSPFix(a6)","  ");
  940.              gen("move.l","d0","-(sp)");
  941.              enter_XREF("_MathBase");
  942.              enter_XREF("_LVOSPFix");
  943.              nftype=longtype;
  944.             }
  945.             else
  946.               if (nftype == stringtype)
  947.                  { _error(4); nftype=undefined; }
  948.  
  949.             /* else if short or long, leave on stack 
  950.                and let nftype remain the same! */
  951.             break;
  952.  
  953.          /* FRE */
  954.            case fresym : if (nftype != stringtype)
  955.                {
  956.                 make_sure_short(nftype);
  957.                 gen("move.w","(sp)+","d0"); /* pop argument */
  958.                 gen("jsr","_fre","  ");
  959.                 gen("move.l","d0","-(sp)");
  960.                 enter_XREF("_fre");
  961.                 nftype=longtype;
  962.                }
  963.                else { _error(4); nftype=undefined; }
  964.                break;
  965.  
  966.      /* GADGET */
  967.      case gadgetsym : nftype = make_integer(nftype);
  968.               if (nftype == shorttype) make_long();
  969.               gen("jsr","_GadFunc","  ");
  970.               gen("addq","#4","sp");
  971.               gen("move.l","d0","-(sp)");
  972.               enter_XREF("_GadFunc");
  973.               nftype=longtype;
  974.               break;
  975.  
  976.      /* HANDLE */
  977.      case handlesym : if (nftype != stringtype)
  978.               {
  979.                check_for_event();
  980.  
  981.                if (make_integer(nftype) == shorttype)
  982.                   make_long();
  983.                gen("move.l","(sp)+","d0");
  984.                gen("jsr","_handle","  ");
  985.                gen("move.l","d0","-(sp)");
  986.                enter_XREF("_handle");
  987.                nftype=longtype;
  988.               }
  989.               else { _error(4); nftype=undefined; }
  990.               break;
  991.  
  992.      /* IFF */
  993.      case iffsym : if (nftype != stringtype)
  994.               {
  995.                check_for_event();
  996.  
  997.                /* channel */
  998.                if (make_integer(nftype) == shorttype)
  999.                   make_long();
  1000.  
  1001.                /* function number */
  1002.                if (sym == comma) 
  1003.                {
  1004.                 insymbol();
  1005.                 if (make_integer(expr()) == shorttype)
  1006.                    make_long();
  1007.  
  1008.                 gen("jsr","_iff_func","  ");
  1009.                 gen("addq","#8","sp");
  1010.                 gen("move.l","d0","-(sp)");    /* push return value */
  1011.                 enter_XREF("_iff_func");
  1012.             
  1013.                 nftype = longtype;
  1014.                }
  1015.                else { _error(16); nftype=undefined; }
  1016.               }
  1017.               else { _error(4); nftype=undefined; }
  1018.               break;
  1019.  
  1020.      /* INT */
  1021.      case intsym  : if (nftype == singletype)
  1022.             {
  1023.              gen("move.l","(sp)+","d0");
  1024.              gen("move.l","_MathBase","a6");
  1025.              gen("jsr","_LVOSPFloor(a6)","  ");
  1026.              gen("jsr","_LVOSPFix(a6)","  ");
  1027.              gen("move.l","d0","-(sp)");
  1028.              enter_XREF("_MathBase");
  1029.              enter_XREF("_LVOSPFloor");
  1030.              enter_XREF("_LVOSPFix");
  1031.              nftype=longtype;
  1032.             }
  1033.             else
  1034.               if (nftype == stringtype)
  1035.                  { _error(4); nftype=undefined; }
  1036.  
  1037.             /* else if short or long, leave on stack 
  1038.                and let nftype remain the same! */
  1039.             break;
  1040.  
  1041.      /* LOC */
  1042.      case locsym  : if (nftype != stringtype)
  1043.             {
  1044.              check_for_event();
  1045.  
  1046.              if (make_integer(nftype) == shorttype)
  1047.                 make_long();
  1048.              gen("jsr","_FilePosition","  ");
  1049.              gen("addq","#4","sp");
  1050.              gen("move.l","d0","-(sp)");
  1051.              enter_XREF("_FilePosition");
  1052.              nftype=longtype;
  1053.             }
  1054.             else { _error(4); nftype=undefined; } 
  1055.              break;
  1056.                
  1057.      /* LOF */
  1058.      case lofsym  : if (nftype != stringtype)
  1059.             {
  1060.              check_for_event();
  1061.  
  1062.              if (make_integer(nftype) == shorttype)
  1063.                 make_long();
  1064.              gen("move.l","(sp)+","d0");
  1065.              gen("jsr","_lof","  ");
  1066.              gen("move.l","d0","-(sp)");
  1067.              enter_XREF("_lof");
  1068.              nftype=longtype;
  1069.             }
  1070.             else { _error(4); nftype=undefined; } 
  1071.              break;
  1072.                
  1073.      /* LOG */
  1074.          case logsym  : nftype = gen_single_func("_LVOSPLog",nftype);
  1075.                 break;
  1076.  
  1077.      /* LONGINT */
  1078.      case longintsym: if (nftype == stringtype)
  1079.               {    
  1080.                 gen("jsr","_long_from_string","  ");
  1081.                 gen("addq","#4","sp");
  1082.                 gen("move.l","d0","-(sp)");
  1083.                 enter_XREF("_long_from_string");
  1084.                 nftype=longtype;
  1085.               }
  1086.               else { _error(4); nftype=undefined; }
  1087.               break;
  1088.         
  1089.      /* MENU */        
  1090.      case menusym : if (nftype != stringtype)
  1091.             {
  1092.                 nftype = make_integer(nftype);
  1093.                 if (nftype == shorttype) make_long();
  1094.                 gen("jsr","_MenuFunc","  ");
  1095.                 gen("addq","#4","sp");
  1096.                 gen("move.l","d0","-(sp)");
  1097.                 enter_XREF("_MenuFunc");
  1098.                 nftype=longtype;
  1099.             }
  1100.             else { _error(4); nftype=undefined; }
  1101.             break;
  1102.             
  1103.      /* MOUSE */
  1104.      case mousesym : if (nftype != stringtype)
  1105.              {
  1106.               make_sure_short(nftype);
  1107.               gen("move.w","(sp)+","d0");
  1108.               gen("jsr","_mouse","  ");
  1109.               gen("move.w","d0","-(sp)");
  1110.               enter_XREF("_mouse");
  1111.               enter_XREF("_IntuitionBase");
  1112.               nftype=shorttype;
  1113.              }
  1114.              else nftype=undefined;
  1115.              break;
  1116.  
  1117.      /* MSGBOX */
  1118.      case msgboxsym : if (nftype == stringtype)     /* message */
  1119.               {
  1120.                if (sym != comma)
  1121.                   { _error(16); nftype=undefined; }
  1122.                else
  1123.                {
  1124.                 insymbol();
  1125.                 if (expr() == stringtype)   /* response #1 */
  1126.                 {
  1127.                  if (sym == comma)
  1128.                  {
  1129.                   insymbol(); 
  1130.                   if (expr() != stringtype) /* response #2 */
  1131.                      { _error(4); nftype=undefined; return; }
  1132.                  }
  1133.                  else
  1134.                       gen("move.l","#0","-(sp)"); /* #2 = NULL*/
  1135.                  
  1136.                  /* call the function */
  1137.                  gen("jsr","_sysrequest","  ");
  1138.                  gen("add.l","#12","sp");
  1139.                  gen("move.w","d0","-(sp)");
  1140.                  enter_XREF("_sysrequest");
  1141.                  enter_XREF("_IntuitionBase");
  1142.                  nftype=shorttype;
  1143.                 }
  1144.                 else { _error(4); nftype=undefined; }
  1145.                }
  1146.               }
  1147.               else { _error(4); nftype=undefined; }
  1148.               break;
  1149.  
  1150.      /* PEEK */
  1151.      case peeksym : nftype=make_integer(nftype);
  1152.             if ((nftype == longtype) || (nftype == shorttype))
  1153.             {
  1154.              /* get address */
  1155.                    if (nftype == shorttype)
  1156.              {
  1157.                 gen("move.w","(sp)+","d0");
  1158.                 gen("ext.l","d0","  ");
  1159.                 gen("move.l","d0","a0");    
  1160.              }
  1161.              else
  1162.                 gen("move.l","(sp)+","a0"); 
  1163.              /* get value */
  1164.              gen("move.b","(a0)","d0");
  1165.              gen("ext.w","d0","  ");
  1166.              /* if n<0 n=255-not(n) */
  1167.              gen("cmp.w","#0","d0");
  1168.              make_label(labname,lablabel);
  1169.              gen("bge.s",labname,"  ");
  1170.              gen("not.w","d0","  ");
  1171.              gen("move.w","#255","d1");
  1172.              gen("sub.w","d0","d1");
  1173.              gen("move.w","d1","d0");
  1174.              gen(lablabel,"  ","  ");
  1175.              gen("move.w","d0","-(sp)");
  1176.              nftype=shorttype;
  1177.             }
  1178.             else { _error(4); nftype=undefined; }
  1179.             break;
  1180.  
  1181.      /* PEEKW */
  1182.      case peekwsym : nftype=make_integer(nftype); 
  1183.              if ((nftype == longtype) || (nftype == shorttype))
  1184.              {
  1185.               /* get address */
  1186.                     if (nftype == shorttype)
  1187.               {
  1188.                  gen("move.w","(sp)+","d0");
  1189.                  gen("ext.l","d0","  ");
  1190.                  gen("move.l","d0","a0");    
  1191.               }
  1192.               else
  1193.                  gen("move.l","(sp)+","a0"); 
  1194.               /* get value */
  1195.               gen("move.w","(a0)","-(sp)");
  1196.               nftype=shorttype;
  1197.              }
  1198.                      break;
  1199.  
  1200.      /* PEEKL */
  1201.      case peeklsym : nftype=make_integer(nftype); 
  1202.              if ((nftype == longtype) || (nftype == shorttype))
  1203.              {
  1204.               /* get address */
  1205.                     if (nftype == shorttype)
  1206.               {
  1207.                  gen("move.w","(sp)+","d0");
  1208.                  gen("ext.l","d0","  ");
  1209.                  gen("move.l","d0","a0");    
  1210.               }
  1211.               else
  1212.                  gen("move.l","(sp)+","a0"); 
  1213.               /* get value */
  1214.               gen("move.l","(a0)","-(sp)");
  1215.               nftype=longtype;
  1216.              }            
  1217.              break;
  1218.  
  1219.     /* POINT */
  1220.     case pointsym :    if (nftype != stringtype)
  1221.             {
  1222.              make_sure_short(nftype);
  1223.              if (sym != comma)
  1224.                 { _error(16); nftype=undefined; }
  1225.              else
  1226.              {
  1227.               insymbol();
  1228.               make_sure_short(expr());
  1229.               gen("move.w","(sp)+","d1");  /* y */
  1230.               gen("move.w","(sp)+","d0");  /* x */
  1231.               gen("move.l","_RPort","a1"); /* rastport */
  1232.               gen("move.l","_GfxBase","a6");
  1233.               gen("jsr","_LVOReadPixel(a6)","  ");
  1234.               gen("move.l","d0","-(sp)");
  1235.               enter_XREF("_LVOReadPixel");
  1236.               enter_XREF("_GfxBase");
  1237.               enter_XREF("_RPort");
  1238.               nftype=longtype;
  1239.              }
  1240.             }
  1241.             else { _error(4); nftype=undefined; }
  1242.             break;
  1243.             
  1244.      /* POTX */
  1245.      case potxsym : if (nftype != stringtype)
  1246.             {
  1247.              make_sure_short(nftype);
  1248.              gen("move.w","(sp)+","d0"); /* pop argument */
  1249.              gen("jsr","_potx","  ");
  1250.              gen("move.w","d0","-(sp)");
  1251.              enter_XREF("_potx");
  1252.              enter_XREF("_DOSBase");
  1253.              nftype=shorttype;
  1254.             }
  1255.             else { _error(4); nftype=undefined; }
  1256.             break;
  1257.  
  1258.      /* POTY */
  1259.      case potysym : if (nftype != stringtype)
  1260.             {
  1261.              make_sure_short(nftype);
  1262.              gen("move.w","(sp)+","d0"); /* pop argument */
  1263.              gen("jsr","_poty","  ");
  1264.              gen("move.w","d0","-(sp)");
  1265.              enter_XREF("_poty");
  1266.              enter_XREF("_DOSBase");
  1267.              nftype=shorttype;
  1268.             }
  1269.             else { _error(4); nftype=undefined; }
  1270.             break;
  1271.  
  1272.      /* SERIAL */
  1273.      case serialsym : if (nftype != stringtype)
  1274.               {
  1275.                check_for_event();
  1276.  
  1277.                /* channel */
  1278.                if (make_integer(nftype) == shorttype)
  1279.                   make_long();
  1280.  
  1281.                /* function number */
  1282.                if (sym == comma) 
  1283.                {
  1284.                 insymbol();
  1285.                 if (make_integer(expr()) == shorttype)
  1286.                    make_long();
  1287.  
  1288.                 gen("jsr","_serial_func","  ");
  1289.                 gen("addq","#8","sp");
  1290.                 gen("move.l","d0","-(sp)");    /* push return value */
  1291.                 enter_XREF("_serial_func");
  1292.             
  1293.                 nftype = longtype;
  1294.                }
  1295.                else { _error(16); nftype=undefined; }
  1296.               }
  1297.               else { _error(4); nftype=undefined; }
  1298.               break;
  1299.  
  1300.      /* SGN */
  1301.      case sgnsym  : if (nftype == shorttype)
  1302.             {
  1303.              gen("move.w","(sp)+","d0");
  1304.              gen("jsr","_sgnw","  ");
  1305.              gen("move.l","d0","-(sp)");
  1306.              enter_XREF("_sgnw");
  1307.              nftype=longtype;
  1308.             }
  1309.             else
  1310.             if (nftype == longtype)
  1311.             {
  1312.              gen("move.l","(sp)+","d0");
  1313.              gen("jsr","_sgnl","  ");
  1314.              gen("move.l","d0","-(sp)");
  1315.              enter_XREF("_sgnl");
  1316.              nftype=longtype;
  1317.             }
  1318.             else
  1319.             if (nftype == singletype)
  1320.             {
  1321.              gen("move.l","(sp)+","d1");
  1322.              gen("jsr","_sgnf","  ");
  1323.              gen("move.l","d0","-(sp)");
  1324.              enter_XREF("_sgnf");
  1325.              enter_XREF("_MathBase");
  1326.              nftype=longtype;
  1327.             }
  1328.             else
  1329.                 { _error(4); nftype=undefined; }
  1330.             break; 
  1331.              
  1332.  
  1333.      /* SHL */
  1334.      case shlsym  : if (nftype != stringtype)
  1335.             {
  1336.              /* value to be shifted */
  1337.              if (make_integer(nftype) == shorttype)
  1338.                 make_long();
  1339.              
  1340.              if (sym == comma)
  1341.              {
  1342.               insymbol();
  1343.               /* shifted by how many bits? */
  1344.               if ((nftype=expr()) != stringtype)
  1345.               {
  1346.                if (make_integer(nftype) == shorttype)
  1347.                   make_long();
  1348.                
  1349.                gen("move.l","(sp)+","d0"); /* pop shift factor */
  1350.                gen("move.l","(sp)+","d1"); /* pop value */
  1351.                gen("asl.l","d0","d1");     /* shift d1 by d0 */
  1352.                gen("move.l","d1","-(sp)"); /* push result */
  1353.                nftype=longtype;
  1354.               }
  1355.               else { _error(4); nftype=undefined; }
  1356.              }
  1357.              else { _error(16); nftype=undefined; }
  1358.             }
  1359.             else { _error(4); nftype=undefined; }
  1360.             break;
  1361.              
  1362.      /* SHR */
  1363.      case shrsym  : if (nftype != stringtype)
  1364.             {
  1365.              /* value to be shifted */
  1366.              if (make_integer(nftype) == shorttype)
  1367.                 make_long();
  1368.              
  1369.              if (sym == comma)
  1370.              {
  1371.               insymbol();
  1372.               /* shifted by how many bits? */
  1373.               if ((nftype=expr()) != stringtype)
  1374.               {
  1375.                if (make_integer(nftype) == shorttype)
  1376.                   make_long();
  1377.                
  1378.                gen("move.l","(sp)+","d0"); /* pop shift factor */
  1379.                gen("move.l","(sp)+","d1"); /* pop value */
  1380.                gen("asr.l","d0","d1");     /* shift d1 by d0 */
  1381.                gen("move.l","d1","-(sp)"); /* push result */
  1382.                nftype=longtype;
  1383.               }
  1384.               else { _error(4); nftype=undefined; }
  1385.              }
  1386.              else { _error(16); nftype=undefined; }
  1387.             }
  1388.             else { _error(4); nftype=undefined; }
  1389.             break;
  1390.             
  1391.      /* SQR */
  1392.          case sqrsym  : nftype = gen_single_func("_LVOSPSqrt",nftype);
  1393.                 break;
  1394.  
  1395.      /* SIN */
  1396.          case sinsym  : nftype = gen_single_func("_LVOSPSin",nftype);
  1397.                 break;
  1398.  
  1399.      /* SIZEOF */
  1400.      case sizeofsym : nftype = find_object_size();
  1401.               break;
  1402.  
  1403.      /* STICK */
  1404.      case sticksym : make_sure_short(nftype);
  1405.              gen("move.w","(sp)+","d0");
  1406.              gen("jsr","_stick","  ");
  1407.              gen("move.w","d0","-(sp)");
  1408.              enter_XREF("_stick");
  1409.              nftype=shorttype;
  1410.              break;
  1411.      /* STRIG */
  1412.      case strigsym : make_sure_short(nftype);
  1413.              gen("move.w","(sp)+","d0");
  1414.              gen("jsr","_strig","  ");
  1415.              gen("move.w","d0","-(sp)");
  1416.              enter_XREF("_strig");
  1417.              nftype=shorttype;
  1418.              break;
  1419.  
  1420.      /* TAN */
  1421.          case tansym  : nftype = gen_single_func("_LVOSPTan",nftype);
  1422.                 break;
  1423.  
  1424.      /* VARPTR */
  1425.      case varptrsym : if (sym == ident) 
  1426.               {
  1427.                strcpy(varptr_obj_name,id);
  1428.                nftype=address_of_object();
  1429.                /* structure and array code returns next symbol */
  1430.                if (!exist(varptr_obj_name,structure) &&
  1431.                    !exist(varptr_obj_name,array)) 
  1432.                   insymbol();
  1433.               }
  1434.               else 
  1435.                  { _error(7); nftype=undefined; insymbol(); }
  1436.               break;
  1437.  
  1438.      /* WINDOW */
  1439.      case windowsym : make_sure_short(nftype);
  1440.                 gen("move.w","(sp)+","d0");
  1441.               gen("jsr","_windowfunc","  ");
  1442.               gen("move.l","d0","-(sp)");
  1443.               enter_XREF("_windowfunc");
  1444.               enter_XREF("_IntuitionBase");
  1445.               nftype=longtype;
  1446.               break;
  1447.  
  1448.      /* SAY */
  1449.      case saysym    : if (nftype != stringtype)
  1450.               {
  1451.                nftype=make_integer(nftype);
  1452.                if (nftype == shorttype) make_long();
  1453.                gen("jsr","_sayfunc","  ");
  1454.                gen("addq","#4","sp");
  1455.                gen("move.l","d0","-(sp)");
  1456.                enter_XREF("_sayfunc");
  1457.                nftype=longtype;
  1458.               }
  1459.               else { _error(4); nftype=undefined; }
  1460.               break;
  1461.  
  1462.      /* SCREEN */
  1463.      case screensym : if (nftype != stringtype)
  1464.               {
  1465.                nftype = make_integer(nftype);
  1466.                if (nftype == shorttype) make_long();
  1467.                gen("jsr","_screenfunc","  ");
  1468.                gen("addq","#4","sp");
  1469.                gen("move.l","d0","-(sp)");
  1470.                enter_XREF("_screenfunc");
  1471.                enter_XREF("_IntuitionBase");
  1472.                nftype=longtype;
  1473.               }
  1474.               else { _error(4); nftype=undefined; }
  1475.               break;
  1476.        }
  1477.    if (sym != rparen) { _error(9); nftype=undefined; }
  1478.   }  
  1479.   insymbol();
  1480.  }
  1481.  return(nftype);
  1482. }
  1483.  
  1484. int address_of_object()
  1485. {
  1486. /* return the address of a variable, array or structure */
  1487. SYM    *varptr_item;
  1488. char   buf[50],numbuf[40];
  1489. char   addrbuf[40];
  1490. char   extobjid[MAXIDSIZE];
  1491. char   subname[MAXIDSIZE+5];
  1492. SYM    *structype;
  1493. STRUCM *member;
  1494. BOOL   found;
  1495.  
  1496.             /* 
  1497.             ** Make external variable/function
  1498.                ** name by removing qualifier and 
  1499.                ** adding an underscore prefix 
  1500.                ** if one is not present. 
  1501.             */
  1502.              strcpy(buf,ut_id);
  1503.              remove_qualifier(buf);
  1504.              if (buf[0] != '_')
  1505.              {
  1506.                strcpy(extobjid,"_\0");
  1507.                strcat(extobjid,buf);
  1508.              }
  1509.                else 
  1510.                            strcpy(extobjid,buf);
  1511.  
  1512.             /*
  1513.             ** Make SUB name.
  1514.             */
  1515.             sprintf(subname,"_SUB_%s",id);
  1516.  
  1517.             /*
  1518.             ** Push address of valid object
  1519.             ** [see ref.doc].
  1520.             */
  1521.                /* external variable or function? */
  1522.                if (exist(extobjid,extvar) || 
  1523.                    exist(extobjid,extfunc))
  1524.                {
  1525.                    gen("pea",extobjid,"  ");
  1526.                    return(longtype);                  
  1527.                }
  1528.                else
  1529.                if (exist(subname,subprogram))
  1530.                {
  1531.                 gen("pea",subname,"  ");
  1532.                 return(longtype);
  1533.                }
  1534.                else
  1535.                /* ordinary variable? */
  1536.                if (exist(id,variable))
  1537.                {
  1538.                 varptr_item=curr_item;
  1539.  
  1540.                 /* get the frame start address */
  1541.                 strcpy(addrbuf,addreg[lev]);
  1542.  
  1543.                 /* get the frame offset */
  1544.                 sprintf(numbuf,"#%ld",varptr_item->address);
  1545.  
  1546.                 /* calculate the absolute address */
  1547.                 gen("move.l",addrbuf,"d0");
  1548.                 gen("sub.l",numbuf,"d0");
  1549.                 if ((varptr_item->type == stringtype)
  1550.                    || ((varptr_item->shared) && (lev == ONE)))
  1551.                 {
  1552.                  /* location in frame contains address */  
  1553.                  gen("move.l","d0","a0");
  1554.                  gen("move.l","(a0)","-(sp)");
  1555.                 }
  1556.                 else
  1557.                 /* absolute address in frame of variable */
  1558.                     gen("move.l","d0","-(sp)");
  1559.                 return(longtype);    
  1560.                }
  1561.                else
  1562.                if ((exist(id,array)) || (exist(id,structure)))
  1563.                {
  1564.                 varptr_item=curr_item;
  1565.  
  1566.                 /* get the frame start address */
  1567.                 strcpy(addrbuf,addreg[lev]);
  1568.  
  1569.                 /* get the frame offset */
  1570.                 sprintf(numbuf,"#%ld",varptr_item->address);
  1571.  
  1572.                 /* calculate the absolute address */
  1573.                 gen("move.l",addrbuf,"d0");
  1574.                 gen("sub.l",numbuf,"d0");
  1575.  
  1576.                 /* location in frame contains array/struct address 
  1577.                    (except for shared structure (see below) */  
  1578.                 gen("movea.l","d0","a0");
  1579.                 
  1580.                 /* address of a structure member? */
  1581.                 if (exist(id,structure))
  1582.                 {
  1583.                  /* shared struct? -> get struct variable address */
  1584.                  if (varptr_item->shared && lev == ONE) 
  1585.                 gen("movea.l","(a0)","a0");
  1586.  
  1587.                  insymbol();  
  1588.                  if (sym == memberpointer)
  1589.                  {
  1590.                   insymbol();  
  1591.                   if (sym != ident) 
  1592.                      _error(7);
  1593.                   {
  1594.                    structype = varptr_item->other;
  1595.                    member = structype->structmem->next;
  1596.                    found=FALSE;
  1597.                    while ((member != NULL) && (!found))
  1598.                    {
  1599.                     if (strcmp(member->name,id) == 0)
  1600.                    found=TRUE;
  1601.                     else
  1602.                     member = member->next;
  1603.                    }
  1604.                    if (!found)
  1605.                    _error(67);  /* not a valid member */
  1606.                    else
  1607.                  {
  1608.                   /* push address of struct member */
  1609.                   sprintf(numbuf,"#%ld",member->offset);
  1610.                   gen("movea.l","(a0)","a0");
  1611.                   gen("adda.l",numbuf,"a0");
  1612.                   gen("move.l","a0","-(sp)");
  1613.                   /* store type for SWAP command */
  1614.                   struct_member_type = member->type;          
  1615.                  }
  1616.                    }
  1617.                   insymbol();
  1618.                  }
  1619.                  else
  1620.                  {
  1621.                   /* address of struct variable in stack frame */
  1622.                   gen("move.l","a0","-(sp)"); 
  1623.                   /* store type for SWAP command */
  1624.                   struct_member_type = longtype;
  1625.                  }          
  1626.                 }
  1627.                 else
  1628.                 /* array or array element address? */
  1629.                 {
  1630.                 /* push array address */
  1631.                     gen("move.l","(a0)","-(sp)"); 
  1632.  
  1633.                 insymbol();
  1634.  
  1635.                 if (sym == lparen)
  1636.                 {
  1637.                  /* calculate array element address */
  1638.                  have_lparen=TRUE;
  1639.                  push_indices(varptr_item);
  1640.                  get_abs_ndx(varptr_item); /* offset -> d7 */
  1641.                  gen("move.l","(sp)+","d0"); /* array start */
  1642.                  gen("add.l","d7","d0"); /* start+offset=addr */
  1643.                   gen("move.l","d0","-(sp)"); /* push address */
  1644.                  insymbol(); /* symbol after rparen */
  1645.                 }
  1646.                 }
  1647.                 return(longtype);        
  1648.                }
  1649.                else { _error(43); return(undefined); }
  1650. }
  1651.  
  1652. int find_object_size()
  1653. {
  1654. /* push the size (in bytes) 
  1655.    of a data object or type 
  1656.    onto the stack. 
  1657. */
  1658. char numbuf[40];
  1659. int  nftype;
  1660.  
  1661.  if (sym == ident)
  1662.  {
  1663.   /* variable */
  1664.   if (exist(id,variable))
  1665.   {
  1666.    if (curr_item->type == shorttype)
  1667.    {
  1668.     gen("move.l","#2","-(sp)"); 
  1669.     nftype=longtype;
  1670.    }
  1671.    else
  1672.    if (curr_item->type == longtype)
  1673.    {
  1674.     gen("move.l","#4","-(sp)"); 
  1675.     nftype=longtype;
  1676.    }
  1677.    else
  1678.    if (curr_item->type == singletype)
  1679.    {
  1680.     gen("move.l","#4","-(sp)"); 
  1681.     nftype=longtype;
  1682.    }
  1683.    else
  1684.    if (curr_item->type == stringtype)
  1685.    {
  1686.     sprintf(numbuf,"#%ld",curr_item->size);
  1687.     gen("move.l",numbuf,"-(sp)"); 
  1688.     nftype=longtype;
  1689.    }
  1690.   }
  1691.   else
  1692.   /* array variable or structure definition? */
  1693.   if (exist(id,array) || exist(id,structdef))
  1694.   {
  1695.    sprintf(numbuf,"#%ld",curr_item->size);
  1696.    gen("move.l",numbuf,"-(sp)"); 
  1697.    nftype=longtype;
  1698.   }
  1699.   else
  1700.   /* structure variable? */
  1701.   if (exist(id,structure))
  1702.   {  
  1703.    sprintf(numbuf,"#%ld",curr_item->other->size);
  1704.    gen("move.l",numbuf,"-(sp)"); 
  1705.    nftype=longtype;
  1706.   }
  1707.   else
  1708.   {
  1709.    _error(43);     /* undeclared array or variable */
  1710.    nftype=undefined;
  1711.   }
  1712.  }
  1713.  else
  1714.   /* type identifier? */
  1715.   if (sym == bytesym)
  1716.   {
  1717.    gen("move.l","#1","-(sp)"); 
  1718.    nftype=longtype;
  1719.   }
  1720.   else
  1721.   if (sym == shortintsym)
  1722.   {
  1723.    gen("move.l","#2","-(sp)"); 
  1724.    nftype=longtype;
  1725.   }
  1726.   else
  1727.   if (sym == longintsym || sym == addresssym)
  1728.   {
  1729.    gen("move.l","#4","-(sp)"); 
  1730.    nftype=longtype;
  1731.   }
  1732.   else
  1733.   if (sym == singlesym)
  1734.   {
  1735.    gen("move.l","#4","-(sp)"); 
  1736.    nftype=longtype;
  1737.   }
  1738.   else
  1739.   if (sym == stringsym)
  1740.   {
  1741.    sprintf(numbuf,"#%ld",MAXSTRLEN);
  1742.    gen("move.l",numbuf,"-(sp)"); 
  1743.    nftype=longtype;
  1744.   }
  1745.   else
  1746.   {
  1747.    /* expected an identifier or type */
  1748.    _error(60);
  1749.    nftype=undefined;
  1750.   }
  1751.  
  1752.  insymbol();
  1753.  return(nftype);
  1754. }
  1755.